knitr::opts_chunk$set(warning=FALSE, message=FALSE, error = FALSE)
# Importiamo tutte le librerie necessarie
library(jsonlite)
library(lubridate)
library(tidyverse)
library(gganimate)
library(purrr)
library(tsibble)
library(modelr)
library(riem)
library(weathermetrics)
library(chorddiag)
Con str(rawTG) vediamo che questo file JSON è una lista, di 3 elementi. Nel primo ci sono dati generali, negli altri due ci sono tutte le conversazioni di gruppo. Ogni elemento della lista è un dataframe, che a sua volta contiene liste e data frame. Estraiamo e ritagliamo fino ad avere solo quello che interessa a noi, il data frame della chat
setwd("~/Computer/R/affettiStabili")
rawTG<-fromJSON("result.json")
TG01<- rawTG[[4]]
# Trasformiamo in una tibble
TG01 <- as_tibble(TG01)
# eliminiamo tutti i partecipanti che hanno scritto meno di 20 messaggi
TG02<-group_by(TG01, from) %>%
filter(n()> 20) %>%
ungroup()
colnames(TG02)[which(names(TG02) == "from")] <- "author"
# Rimuoviamo i messaggi di sistema (NA)
TG02 <- filter(TG02,
!is.na(author))
# Campio anche il mio nick per allinearlo con gli altri (è più estetica che altro)
TG02$author[which(TG02$author == "arteteco")] <- "Psilocybe"
TG02 <- filter(TG02, author!="Quiz Bot")
Le colonne presenti sono:
id che è sempre meglio averetype è sempre message, quindi non ci servedate, fondamentaleedited porta molti messaggi al 1970. Non ci occorre.action. È sempre NA. Possiamo eliminarlomembers è sempre NULLphoto è NA quando non c’è una foto, mentre c’è del testo quando è stata inviata un’immaginewidth e height ci informano della grandezza dell’immagine.file ci dice della presenza di un file generico. Possiamo tenerlothumbnail avrebbe senso se avessimo scaricato anche le immagini. Attualmente è ridondante rispetto a photomedia_type e mime_type ci danno informazioni simili ma non ridondanti sui media inviati, e teniamo entrambi.duration_seconds è la lunghezza dei mediareply_to_message_id indica a quale messaggio si sta rispondendo. Non mi sembra inutile.sticker_emoji è carinomessage_id è tutto NA, si può togliere.via_bot al limite ci dice se la gif è stata inviata da @gif. Si può togliere.author è l’autore.Altro
Converrà convertire la colonna date in data type date
# sistemiamo il dataset per lavorare più comodamente con le date
TG05<-mutate(TG02,
dateTime = parse_datetime(date, "%Y-%m-%dT%H:%M:%S"),
year = year(dateTime),
month = month(dateTime),
day = day(dateTime),
hour = hour(dateTime),
minute = minute(dateTime),
second = second(dateTime),
date = date(dateTime)
)
A che ora si tende a scrivere?
Aff <- group_by(TG05, hour) %>%
count() %>%
arrange(desc(n))
ggplot(TG05) +
geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
geom_vline(aes(xintercept=mean(hour)),
color="blue", linetype="dashed", size=1)+
labs(x = "Ora")
L’ora di punta sono le 21.
ggplot(TG05) +
geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
facet_wrap(author ~ .)+
labs(x = "Ora")
byMonth <- mutate(TG05,
yearmonth = format((yearmonth(date)), format = "%Y-%m"))
ggplot(byMonth) +
geom_density(color="darkblue", fill="lightblue", mapping=aes(x=hour, y=..scaled..))+
facet_wrap(yearmonth ~ .)+
labs(x = "Ora")
In generale, cogliamo l’occasione e visualizziamo un grafico cumulativo per settimana
history<-select(TG05, author, date, text)
history <- mutate(history,
yearWeek = yearweek(date)) %>%
group_by(yearWeek, author) %>%
count() %>%
group_by(author) %>%
mutate (cumText = cumsum(n))
ggplot(history, aes(x=yearWeek, y=cumText, fill=author)) +
geom_area() +
labs(x = "Settimana", y="Numero messaggi")
Chi ha risposto a chi, e quanto?
È un grafico interattivo. Passando con il mouse sugli elementi si hanno informazioni
RepliedTo <- TG05 %>%
mutate(
reply_to_author = author[match(reply_to_message_id, id)])
#A noi interessano solo 3 colonne: chi ha scritto, a chi, e quanto, e poi trasformarlo in matrice per plottarlo
RepliedTo <- filter(RepliedTo,
!is.na(reply_to_author)) %>%
group_by(
author, reply_to_author
) %>%
count()
# prepariamoci il data frame per avere una matrice
RepliedTo <- pivot_wider(RepliedTo, names_from=reply_to_author, values_from=n)
RepliedTo[is.na(RepliedTo)] <- 0
RepliedToMatrix <- data.matrix(RepliedTo)
row.names(RepliedToMatrix) <- RepliedTo$author
RepliedToMatrix <- RepliedToMatrix[,-1]
# Ora, il grafico
groupColors <- c("#000000", "#FFDD89", "#957244", "#F26223", "#e4704b", "#90eb96", "#472c86", "#c3f729", "#004d8e", "#6d9db0", "#71b1e4", "#516afe")
nomi <- (dimnames(RepliedToMatrix)[[1]])
dimnames(RepliedToMatrix) <- list( autore = nomi,
risposto = nomi)
p <- chorddiag(RepliedToMatrix, groupColors = groupColors, groupnamePadding = 20,showTicks = F)
p
Quale sembra essere il futuro di questa chat? Iniziamo a fare una regressione sul numero di messaggi a settimana per farci un’idea
totText<-TG05 %>%
group_by(date) %>%
count()
modLm <- lm(n ~ date, data = totText)
gridLm <- add_predictions(totText, modLm)
ggplot(totText, aes(date)) +
geom_point(aes(y = n)) +
geom_line(aes(y = gridLm$pred), color = "blue", size = 1, method='lm')+
labs(x = "Data", y="Numero Messaggi")
E con un modello loess
modLoess <- loess(n ~ as.numeric(date), data = totText)
gridLoess <- add_predictions(totText, modLoess)
ggplot(totText, aes(x=date, y=n)) +
geom_point() +
geom_smooth(aes(y = gridLoess$pred), size = 1, method='loess')+
labs(x = "Data", y="Numero Messaggi")
La cosa più scontata potrebbe essere fare una conta del numero di messaggi per persona.
NText<-TG05 %>% group_by(author)%>% drop_na(author) %>% count() %>% arrange(desc(n))
ggplot(data = NText) +
geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=n, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1))+
labs(x = "Autore", y="Numero Messaggi")
Il vincitore sembra Ramphastos, ma è davvero così? Molte persone tendono a separare i contenuti in più messaggi per qualche motivo.
Quindi, facciamo una conta dei caratteri inviati da ogni persona.
NChar<-group_by(TG05, author) %>%
mutate(nChar = sum(nchar(text, type="chars", ), na.rm=TRUE)) %>%
group_by(author, nChar) %>%
group_keys() %>%
arrange(desc(nChar))
ggplot(data = NChar) +
geom_bar(mapping = aes(y = nChar, x = reorder(author, nChar), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=nChar, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1))+
labs(x = "Autore", y="Numero Caratteri")
È ufficiale: Corvus è il vincitore.
Siamo nel 2020, e come omaggio ai tempi è d’obbligo un barplot race che non introduca nessuna informazione rilevante
# Vogliamo che ci sia sempre una riga per l'autore in ogni giorno, altrimenti il grafico sobbalza
rankHistory <-
complete(TG05, date, author) %>%
group_by(date, author) %>%
count() %>%
group_by(author) %>%
mutate (cumText = cumsum(n)) %>%
group_by(date) %>%
arrange(date, desc(cumText)) %>%
mutate(rank = 1:n())
# Ora l'animazione
p <- rankHistory %>%
ggplot(aes(x = -rank,y = cumText, group = author)) +
geom_tile(aes(y = cumText / 2, height = cumText, fill = author), width = 0.9) +
geom_text(aes(label = author), hjust = "right", colour = "black", fontface = "bold", nudge_y = -200) +
geom_text(aes(label = scales::comma(cumText)), hjust = "left", nudge_y = 200, colour = "grey30") +
coord_flip(clip="off") +
scale_x_discrete("") +
scale_y_continuous("",labels=scales::comma) +
theme(panel.grid.major.y=element_blank(),
panel.grid.minor.x=element_blank(),
legend.position="none",
plot.margin = margin(1,1,1,2,"cm"),
axis.text.y=element_blank()) +
# inizia la transizione
transition_time(date) +
ease_aes('cubic-in-out') +
labs(title='Numero di messaggi il',
subtitle=' {round(frame_time,0)}'
)
animate(p, duration = 20, fps = 15, end_pause = 50, width = 800, height = 600)
Agganciandoci a prima, chi è che indulge nella barbaria di spezzettare continuamente i propri messaggi? Calcoliamoci la media di caratteri per messaggio.
Spez <- merge(NChar, NText, by = "author") %>%
mutate(IS = n/nChar) %>%
mutate(mediaCxT = nChar/n) %>%
arrange(desc(IS))
Lo spezzettatore più grande è Pieris, con un indice di spezzettamento di 0.04 e una media di caratteri per messaggio di 21.4484493.
I messaggi in media più lunghi sono invece di Deb, lunghi 56.9318182 caratteri. La differenza non è enorme comunque.
Chi invia più vocali o videomessaggi invece che messaggi scritti? Procediamo come prima
# Prendiamoci solo i messaggi che abbiano un vocale
NVoc<-TG05 %>%
filter(media_type == "voice_message" | media_type == "video_message")
# Contiamoli raggruppati per autore
NVoc<- group_by(NVoc, author)%>%
drop_na(author) %>%
count() %>%
arrange(desc(n))
# Plottiamo
ggplot(data = NVoc) +
geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=n, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1)
)+
labs(x = "Numero Vocali", y="Autore")
Ramphastos sembra la persona che manda più video e audio messaggi.
Però il risultato andrebbe comparato al totale dei messaggi, quindi quanti messaggi vocali in proporzione?
NVoc <- rename(NVoc, nVoc = n)
NText <- rename(NText, nText = n)
NVocProp <- merge(NVoc, NText, by = "author") %>%
mutate(prop = round(nText/nVoc, digits=2)) %>%
arrange(prop)
ggplot(data = NVocProp) +
geom_bar(mapping = aes(y = prop, x = reorder(author, -prop), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=prop, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1)
)+
labs(y = "Messaggi totale / vocali", x="Autore")
Scopriamo che il più pigro è in realtàUrsus, che invia un vocale o un video ogni 14.7 messaggi
Abbiamo a disposizione una colonna di risposta ai messaggi: reply_to_message_id. Da qui è facile vedere chi risponde più spesso. A noi interessa sapere in rapporto ai messaggi inviati però
Nreplies<-TG05 %>%
filter(!is.na(reply_to_message_id)) %>%
group_by(author)%>%
drop_na(author) %>%
count() %>%
rename(nReplies = n) %>%
arrange(desc(nReplies))
NrepliesProp <- merge(Nreplies, NText, by = "author") %>%
mutate(mediaRisposte = round(nText/nReplies),2) %>%
arrange(desc(mediaRisposte))
ggplot(data = NrepliesProp) +
geom_bar(mapping = aes(y = mediaRisposte, x = reorder(author, -mediaRisposte), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=mediaRisposte, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1)
)+
labs(x = "Autore", y="Totale messaggi / risposte")
Ramphastos è il maggior risponditore in assoluto, con risposte, ma rispetto ai messaggi complessivi dell’autore ci sono dei parimeriti. Di sicuro Ficus risponde di meno, con una media di una risposta ogni 19 messaggi.
Ma a chi risponde? Chi è che è il più risposto? Possiamo usare l’ID del messaggio nella colonna reply_to_message_id per risalire all’autore e vedere anche questo
messaggiRisposti<- TG05$reply_to_message_id
messaggiRisposti <- messaggiRisposti[!is.na(messaggiRisposti)]
MR<-filter(
TG05,
id %in% messaggiRisposti
) %>%
group_by(author) %>%
count() %>%
arrange(desc(n))
ggplot(data = MR) +
geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=n, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1)
)+
labs(y = "Messaggi a cui si ha avuto risposta", x="Autore")
# filtriamo il dataset, vogliamo solo l'ultimo mese
TG06 <- mutate(TG05,
yearmonth=yearmonth(date)) %>%
filter(yearmonth==max(yearmonth)) %>%
arrange(date)
rankHistory <-
complete(TG06, date, author) %>%
group_by(date, author) %>%
count() %>%
group_by(author) %>%
mutate (cumText = cumsum(n)) %>%
group_by(date) %>%
arrange(date, desc(cumText)) %>%
mutate(rank = 1:n())
# Ora l'animazione
p <- rankHistory %>%
ggplot(aes(x = -rank,y = cumText, group = author)) +
geom_tile(aes(y = cumText / 2, height = cumText, fill = author), width = 0.9) +
geom_text(aes(label = author), hjust = "right", colour = "black", fontface = "bold", nudge_y = -200) +
geom_text(aes(label = scales::comma(cumText)), hjust = "left", nudge_y = 200, colour = "grey30") +
coord_flip(clip="off") +
scale_x_discrete("") +
scale_y_continuous("",labels=scales::comma) +
theme(panel.grid.major.y=element_blank(),
panel.grid.minor.x=element_blank(),
legend.position="none",
plot.margin = margin(1,1,1,2,"cm"),
axis.text.y=element_blank()) +
# inizia la transizione
transition_time(date) +
ease_aes('cubic-in-out') +
labs(title='Numero di messaggi il',
subtitle=' {round(frame_time,0)}'
)
animate(p, duration = 20, fps = 15, end_pause = 50, width = 800, height = 600)
TG06
## # A tibble: 1,324 x 36
## id type date actor actor_id action title members text photo width
## <int> <chr> <date> <chr> <int> <chr> <chr> <list> <lis> <chr> <int>
## 1 120624 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> 178
## 2 120629 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 3 120634 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 4 120636 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 5 120640 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 6 120645 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 7 120646 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> 240
## 8 120647 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 9 120648 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## 10 120649 mess… 2020-07-01 <NA> NA <NA> <NA> <NULL> <chr… <NA> NA
## # … with 1,314 more rows, and 29 more variables: height <int>, author <chr>,
## # from_id <int>, file <chr>, thumbnail <chr>, media_type <chr>,
## # mime_type <chr>, duration_seconds <int>, reply_to_message_id <int>,
## # sticker_emoji <chr>, location_information$latitude <dbl>, $longitude <dbl>,
## # message_id <int>, forwarded_from <chr>, edited <chr>, via_bot <chr>,
## # poll$question <chr>, $closed <lgl>, $total_voters <int>, $answers <list>,
## # live_location_period_seconds <int>, dateTime <dttm>, year <dbl>,
## # month <dbl>, day <int>, hour <int>, minute <int>, second <dbl>,
## # yearmonth <mth>
NText<-TG06 %>% group_by(author)%>% drop_na(author) %>% count() %>% arrange(desc(n))
NChar<-group_by(TG06, author) %>%
mutate(nChar = sum(nchar(text, type="chars", ), na.rm=TRUE)) %>%
group_by(author, nChar) %>%
group_keys() %>%
arrange(desc(nChar))
ggplot(data = NText) +
geom_bar(mapping = aes(y = n, x = reorder(author, n), fill=author, group = author),
stat = "identity")+
coord_flip()+
geom_text(stat='count',
aes(label=n, x=author, group=author),
hjust = -0.5,
size = 3,
position = position_dodge(width = 1))+
labs(x = "Autore", y="Numero Messaggi")
Il vincitore sembra Ramphastos!
La persona che ha scritto più caratteri è Ramphastos (E QUESTO È PIÙ IMPORTANTE)
Chi ha parlato di più in bolle e vocali?
chiaccherone <- group_by(TG06, author) %>% summarize(lung = sum(duration_seconds, na.rm=TRUE)) %>% arrange(desc(lung))
chiaccherone
## # A tibble: 12 x 2
## author lung
## <chr> <int>
## 1 Ramphastos 283
## 2 Ursus 236
## 3 Rana 184
## 4 Pieris 54
## 5 Vitis 48
## 6 Ananas 45
## 7 Ficus 27
## 8 Corvus 15
## 9 Joe Lucrezia 14
## 10 Psilocybe 12
## 11 Parus 7
## 12 Phasianus 0
Ramphastos è il chiaccherone, con 283 secondi di messaggi vocali, bolle ecc.